home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / gnus / nngateway.el.z / nngateway.el
Encoding:
Text File  |  1998-05-21  |  2.6 KB  |  83 lines
  1. ;;; nngateway.el --- posting news via mail gateways
  2. ;; Copyright (C) 1996,97 Free Software Foundation, Inc.
  3.  
  4. ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
  5. ;; Keywords: news, mail
  6.  
  7. ;; This file is part of GNU Emacs.
  8.  
  9. ;; GNU Emacs is free software; you can redistribute it and/or modify
  10. ;; it under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; GNU Emacs is distributed in the hope that it will be useful,
  15. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17. ;; GNU General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  21. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22. ;; Boston, MA 02111-1307, USA.
  23.  
  24. ;;; Commentary:
  25.  
  26. ;;; Code:
  27.  
  28. (require 'nnoo)
  29. (require 'message)
  30.  
  31. (nnoo-declare nngateway)
  32.  
  33. (defvoo nngateway-address nil
  34.   "Address of the mail-to-news gateway.")
  35.  
  36. (defvoo nngateway-header-transformation 'nngateway-simple-header-transformation
  37.   "Function to be called to rewrite the news headers into mail headers.
  38. It is called narrowed to the headers to be transformed with one
  39. parameter -- the gateway address.")
  40.  
  41. ;;; Interface functions
  42.  
  43. (nnoo-define-basics nngateway)
  44.  
  45. (deffoo nngateway-open-server (server &optional defs)
  46.   (if (nngateway-server-opened server)
  47.       t
  48.     (unless (assq 'nngateway-address defs)
  49.       (setq defs (append defs (list (list 'nngateway-address server)))))
  50.     (nnoo-change-server 'nngateway server defs)))
  51.  
  52. (deffoo nngateway-request-post (&optional server)
  53.   (when (or (nngateway-server-opened server)
  54.         (nngateway-open-server server))
  55.     ;; Rewrite the header.
  56.     (let ((buf (current-buffer)))
  57.       (nnheader-temp-write nil
  58.     (insert-buffer-substring buf)
  59.     (message-narrow-to-head)
  60.     (funcall nngateway-header-transformation nngateway-address)
  61.     (goto-char (point-max))
  62.     (insert mail-header-separator "\n")
  63.     (widen)
  64.     (let (message-required-mail-headers)
  65.       (funcall message-send-mail-function))))))
  66.  
  67. ;;; Internal functions
  68.  
  69. (defun nngateway-simple-header-transformation (gateway)
  70.   "Transform the headers to use GATEWAY."
  71.   (let ((newsgroups (mail-fetch-field "newsgroups")))
  72.     (message-remove-header "to")
  73.     (message-remove-header "cc")
  74.     (goto-char (point-min))
  75.     (insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-)
  76.         "@" gateway "\n")))
  77.  
  78. (nnoo-define-skeleton nngateway)
  79.  
  80. (provide 'nngateway)
  81.  
  82. ;;; nngateway.el ends here
  83.